home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / demostu2 / glenz1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-12-12  |  10.1 KB  |  498 lines
  1. program glenz1;
  2. {
  3.     Glenz vector #1
  4.     - by Bjarke Viksφe
  5.     aug 1994
  6.  
  7.   On a 320x200x16 colour screen.
  8.   No tweaking here, my friend. The vector routine is pretty much the
  9.   same as allways, though.
  10.   But instead of writing colours to all bitplanes, I simply fill out
  11.   one bitplane at a time and set up the palette to look like it's
  12.   all transparent!
  13. }
  14.  
  15. {{$DEFINE DEBUG}
  16.  
  17. uses
  18.     DEMOINIT;
  19.  
  20. const
  21.     WIDTH = 40;
  22.     NUMBER_FACES = 24;
  23.     NUMBER_COORDS = 14;
  24.     BOX = 115; {size of box}
  25.     BOXA = 60;
  26.  
  27. type
  28.     facetype = RECORD
  29.         l1,l2,l3,l4 : byte;
  30.         shown,up : boolean;
  31.     end;
  32.  
  33. var
  34.     slope                    : array[0..200*2] of integer;
  35.     face                    : array[1..NUMBER_FACES] of facetype;
  36.     cbuffer                : array[0..NUMBER_COORDS*2-1] of integer;
  37.  
  38.     miny,maxy             : integer;
  39.     scrminy,scrmaxy     : integer;
  40.     lastscrminy, lastscrmaxy : integer;
  41.  
  42.     sinustabel            : array[0..639] of integer;
  43.     v1,v2,v3                : word;
  44.     cos1,sin1,cos2,sin2,cos3,sin3 : integer;
  45.  
  46.     LineTable1 : array[0..319] of byte;
  47.     LineTable2 : array[0..319] of byte;
  48.  
  49.  
  50. const
  51.     display1 : word = $0000;
  52.     display2 : word = $4000;
  53.     coords : array[0..NUMBER_COORDS*3-1] of integer =
  54.         (box,box,-box, -box,box,-box, -box,-box,-box, box,-box,-box,
  55.         box,box,box, -box,box,box, -box,-box,box, box,-box,box,
  56.         0,box+boxa,0, 0,-box-boxa,0, box+boxa,0,0, -box-boxa,0,0,
  57.         0,0,box+BOXA, 0,0,-box-boxa);
  58.  
  59.  
  60. (*------------------------------------------------*)
  61.  
  62. procedure SetupSinus;
  63. var
  64.     i : integer;
  65.     v, vadd : real;
  66. begin
  67.     v:=0.0;
  68.     vadd:=(2.0*pi/512.0);
  69.     for i:=0 to 639 do begin
  70.         sinustabel[i]:=round(sin(v)*32767);
  71.         v:=v+vadd;
  72.     end;
  73. end;
  74.  
  75. procedure SetupCoords;
  76. begin
  77.     with face[1] do begin l1:=1; l2:=0; l3:=13; up:=FALSE; end;
  78.     with face[2] do begin l1:=2; l2:=1; l3:=13; up:=TRUE; end;
  79.     with face[3] do begin l1:=3; l2:=2; l3:=13; up:=FALSE; end;
  80.     with face[4] do begin l1:=0; l2:=3; l3:=13; up:=TRUE; end;
  81.  
  82.     with face[5] do begin l1:=4; l2:=5; l3:=12; up:=FALSE; end;
  83.     with face[6] do begin l1:=5; l2:=6; l3:=12; up:=TRUE; end;
  84.     with face[7] do begin l1:=6; l2:=7; l3:=12; up:=FALSE; end;
  85.     with face[8] do begin l1:=7; l2:=4; l3:=12; up:=TRUE; end;
  86.  
  87.     with face[9] do begin l1:=0; l2:=1; l3:=8; up:=TRUE; end;
  88.     with face[10] do begin l1:=1; l2:=5; l3:=8; up:=FALSE; end;
  89.     with face[11] do begin l1:=5; l2:=4; l3:=8; up:=TRUE; end;
  90.     with face[12] do begin l1:=4; l2:=0; l3:=8; up:=FALSE; end;
  91.  
  92.     with face[13] do begin l1:=2; l2:=3; l3:=9; up:=TRUE; end;
  93.     with face[14] do begin l1:=3; l2:=7; l3:=9; up:=FALSE; end;
  94.     with face[15] do begin l1:=7; l2:=6; l3:=9; up:=TRUE; end;
  95.     with face[16] do begin l1:=6; l2:=2; l3:=9; up:=FALSE; end;
  96.  
  97.     with face[17] do begin l1:=1; l2:=2; l3:=11; up:=FALSE; end;
  98.     with face[18] do begin l1:=2; l2:=6; l3:=11; up:=TRUE; end;
  99.     with face[19] do begin l1:=6; l2:=5; l3:=11; up:=FALSE; end;
  100.     with face[20] do begin l1:=5; l2:=1; l3:=11; up:=TRUE; end;
  101.  
  102.     with face[21] do begin l1:=3; l2:=0; l3:=10; up:=FALSE; end;
  103.     with face[22] do begin l1:=0; l2:=4; l3:=10; up:=TRUE; end;
  104.     with face[23] do begin l1:=4; l2:=7; l3:=10; up:=FALSE; end;
  105.     with face[24] do begin l1:=7; l2:=3; l3:=10; up:=TRUE; end;
  106. end;
  107.  
  108. procedure InitDemo;
  109. var
  110.     i : integer;
  111. begin
  112.     Screen_Off;
  113.     ClearWholeScreen;
  114.     SetupSinus;
  115.     SetupCoords;
  116.  
  117.     scrminy := 0; scrmaxy := 200;
  118.     lastscrminy := 0; lastscrmaxy := 200;
  119.     v1:=0; v2:=0; v3:=0;
  120.  
  121.     for i:=0 to 319 do begin
  122.         LineTable1[i]:=2 SHL ((7-i) AND 7)-1;
  123.         LineTable2[i]:=(255 SHL ((7-i) AND 7));
  124.     end;
  125.     for i:=0 to 200 do ytabel[i]:=i*WIDTH;
  126.  
  127.     SetRGB(0,0,0,0);
  128.     SetRGB(1,60,15,15); {001} {all xx1 bits are darkred faces}
  129.     SetRGB(2,60,24,24); {010} {all x1x bits are lightred faces}
  130.     SetRGB(3,60,24,24); {011}
  131.     SetRGB(4,63,63,63); {100} {all 1xx bits are white faces}
  132.     SetRGB(5,60,60,60); {101}
  133.     SetRGB(6,63,63,63); {110}
  134.     SetRGB(7,63,63,63); {111}
  135.  
  136.     Screen_On;
  137. end;
  138.  
  139.  
  140. (*------------------------------------------------*)
  141.  
  142. procedure SwapDisplay;
  143. var
  144.     temp : word;
  145. begin
  146.     temp:=display2;
  147.     display2:=display1;
  148.     display1:=temp;
  149.     SetAddress(Ptr(SEGA000,display2));
  150. end;
  151.  
  152. procedure ClearScreen(y1,y2 : integer); assembler;
  153. {Yes, clear the screen... or the part of it we use!}
  154. asm
  155.     mov    es,SEGA000
  156.     mov    di,display1
  157.     add    di,(WIDTH*15)+8
  158.     xor ax,ax
  159.     mov    dx,170    {height}
  160.     cld
  161. @loop:
  162.     mov    cx,(192/8)/2    {width}
  163.     rep stosw
  164.     add    di,(320-192)/8
  165.     dec    dx
  166.     jnz    @loop
  167. end;
  168.  
  169.  
  170. (*------------------------------------------------*)
  171.  
  172. procedure ClearSlope; assembler;
  173. asm
  174.     mov    ax,ds
  175.     mov    es,ax
  176.     lea    di,slope
  177.     DB LONG; mov ax,$8000; DW $8000;
  178.     cld
  179.     mov    cx,200
  180.     rep; DB LONG; stosw
  181. end;
  182.  
  183. procedure CalcSlope(l1,l2 : integer); assembler;
  184. {Calc edgebuffer for face}
  185. var
  186.     ysize : integer;
  187. asm
  188.     lea    si,cbuffer
  189.     DB LONG; xor cx,cx
  190.     mov    bx,l1
  191.     shl    bx,2
  192.     mov    ax,[si+bx]
  193.     mov    cx,[si+bx+2]
  194.     mov    bx,l2
  195.     shl    bx,2
  196.     add    si,bx
  197.     mov    dx,[si]
  198.     mov    bx,[si+2]
  199.  
  200.     cmp    bx,cx
  201.     jle    @noswap
  202.     xchg    ax,dx
  203.     xchg    bx,cx
  204. @noswap:
  205.     cmp    bx,miny
  206.     jae    @miny
  207.     mov    miny,bx
  208. @miny:
  209.     cmp    cx,maxy
  210.     jbe    @maxy
  211.     mov    maxy,cx
  212. @maxy:
  213.  
  214.     sub    cx,bx
  215.     jcxz    @zero
  216.     mov    ysize,cx
  217.     add    bx,bx
  218.     add    bx,bx
  219.     lea    si,slope
  220.     add    si,bx
  221.  
  222.     mov    bx,dx {hide it in BX}
  223.     sub    ax,dx
  224.     inc    ax
  225.  
  226.     DB LONG; shl ax,16
  227.     {cdq} DB $66,$99
  228.     DB LONG; idiv cx
  229.     DB LONG; mov dx,ax
  230.     DB LONG; shr dx,16
  231.  
  232. @one:
  233.  
  234.     mov    cx,bx {retrive hidden DX}
  235.     xor    bx,bx
  236.     mov    di,$8000
  237.     push    bp
  238.     mov    bp,ysize
  239. @loop:
  240.     cmp    [si],di    {is first slot occupied? use other then...}
  241.     jne    @other
  242.     mov    [si],cx
  243.     add    bx,ax
  244.     adc    cx,dx
  245.     add    si,4
  246.     dec    bp
  247.     jnz    @loop
  248.     jmp    NEAR PTR @done
  249. @other:
  250.     mov    [si+2],cx
  251.     add    bx,ax
  252.     adc    cx,dx
  253.     add    si,4
  254.     dec    bp
  255.     jnz    @loop
  256. @done:
  257.     pop    bp
  258. @zero:
  259. end;
  260.  
  261.  
  262. (*------------------------------------------------*)
  263.  
  264. procedure CalcAngle;
  265. begin
  266.     sin1:=sinustabel[v1]; cos1:=sinustabel[v1+128];
  267.     sin2:=sinustabel[v2]; cos2:=sinustabel[v2+128];
  268.     sin3:=sinustabel[v3]; cos3:=sinustabel[v3+128];
  269.     v1:=(v1-2) AND 511;
  270.     v2:=(v2-1) AND 511;
  271.     v3:=(v3+1) AND 511;
  272. end;
  273.  
  274. procedure RotateAllCoords;
  275. var
  276.     i, a,b : integer;
  277.     x,y,z : longint;
  278.     temp : integer;
  279. begin
  280.     a:=0; b:=0;
  281.     for i:=1 to NUMBER_COORDS do begin
  282.         x:=coords[a]; y:=coords[a+1]; z:=coords[a+2];
  283.         inc(a,3);
  284.  
  285.         temp:=y;
  286.         y:=(LongMul(y,cos1) - LongMul(z,sin1)) DIV 32768;
  287.         z:=(LongMul(temp,sin1) + LongMul(z,cos1)) DIV 32768;
  288.         temp:=x;
  289.         x:=(LongMul(x,cos2) + LongMul(z,sin2)) DIV 32768;
  290.         z:=(LongMul(z,cos2) - LongMul(temp,sin2)) DIV 32768;
  291.         temp:=x;
  292.         x:=(LongMul(x,cos3) - LongMul(y,sin3)) DIV 32768;
  293.         y:=(LongMul(temp,sin3) + LongMul(y,cos3)) DIV 32768;
  294.  
  295.         cbuffer[b]:=((x SHL 8) DIV (z+800))+160;
  296.         cbuffer[b+1]:=((y SHL 8) DIV (z+800))+100;
  297.         inc(b,2);
  298.     end;
  299. end;
  300.  
  301.  
  302. function FaceShown(i : integer; l1,l2,l3 : byte) : boolean;
  303. {Is face turning the back on us? Then don't show it.
  304.  Formula is: (x1-x2)*(y3-y2) - (x1-x2)*(y3-y2) > 0}
  305. var
  306.     a,b : longint;
  307. begin
  308.     a := LongMul(cbuffer[l1]-cbuffer[l2],cbuffer[l3+1]-cbuffer[l2+1]);
  309.     b := LongMul(cbuffer[l1+1]-cbuffer[l2+1],cbuffer[l3]-cbuffer[l2]);
  310.     face[i].shown:=(a-b) > 0;
  311. end;
  312.  
  313.  
  314. procedure FillShape(y,ysize : integer; color : byte); assembler;
  315. asm
  316.     cmp    ysize,200
  317.     jae    @done
  318.     mov    ax,y
  319.     add    ax,ax
  320.     mov    si,ax
  321.     mov    di,[si+OFFSET ytabel]
  322.     add    di,display1 {find vga address offset}
  323.     lea    si,slope {find where edgebuffer begins}
  324.     add    ax,ax
  325.     add    si,ax
  326.  
  327.     mov    es,SEGA000
  328.     mov    dx,$3CE {prepare set bitplanes}
  329.     mov    al,$08
  330.     out    dx,al
  331.     cld
  332. @yloop:
  333.     lodsw
  334.     mov    dx,ax
  335.     lodsw
  336.     cmp    ax,dx
  337.     jle    @exchange
  338.     xchg    ax,dx
  339. @exchange:
  340.  
  341.     cmp    dx,0
  342.     jl        @filledout_fast
  343.     cmp    ax,320
  344.     jge    @filledout_fast
  345.     cmp    ax,0
  346.     jge    @cut1
  347.     xor    ax,ax
  348. @cut1:
  349.     cmp    dx,319
  350.     jle    @cut2
  351.     mov    dx,319
  352. @cut2:
  353.     push    si
  354.     push    di
  355.     mov    bx,ax
  356.     mov    si,dx
  357.     mov    dx,$3CF
  358.  
  359.     mov    al,[bx+OFFSET LineTable1]
  360.     mov    ah,[si+OFFSET LineTable2]
  361.     shr    bx,3
  362.     shr    si,3
  363.     mov    cx,si
  364.     sub    cx,bx
  365.     jcxz    @1
  366.  
  367.     dec    cx
  368.     add    di,bx
  369.     mov    bh,ah
  370.     out    dx,al
  371.     mov    bl,color
  372.     mov    al,[es:di]
  373.     mov    [es:di],bl
  374.     inc    di
  375.     jcxz    @4
  376.     mov    al,$FF
  377.     out    dx,al
  378.  
  379.     mov    al,bl
  380.     mov    ah,al
  381.     shr    cx,1
  382.     rep stosw
  383.     adc    cx,0
  384.     rep stosb
  385.  
  386. @4:
  387.     mov    al,bh
  388.     out    dx,al
  389.     mov    al,[es:di]
  390.     mov    [es:di],bl
  391.     jmp NEAR PTR @filledout
  392.  
  393. @1:
  394.     add    di,bx
  395.     mov    bl,color
  396.     and    al,ah
  397.     out    dx,al
  398.     mov    al,[es:di]
  399.     mov    [es:di],bl
  400.  
  401.  
  402. @filledout:
  403.     pop    di
  404.     pop    si
  405. @filledout_fast:
  406.     add    di,WIDTH
  407.     dec    ysize
  408.     jnz    @yloop
  409. @done:
  410. end;
  411.  
  412.  
  413. procedure RunOnce;
  414. var
  415.     i : integer;
  416. begin
  417.     SwapDisplay;
  418.     VBLANK;
  419. {$IFDEF DEBUG}
  420.     SetRGB(0,20,0,0);
  421. {$ENDIF}
  422.  
  423.     SetWriteMode(2);
  424.     SetBitMaskRegister($FF);
  425.     SetBitplanes(15);
  426.     ClearScreen(lastscrminy,lastscrmaxy);
  427.  
  428.     lastscrminy := scrminy; lastscrmaxy := scrmaxy;
  429.     scrminy := 200; scrmaxy := 0;
  430.  
  431.     CalcAngle;
  432.     RotateAllCoords;
  433.  
  434.     {calc which faces are front/behind...}
  435.     for i:=1 to NUMBER_FACES do with face[i] do
  436.         FaceShown(i, l1 SHL 1,l2 SHL 1,l3 SHL 1);
  437.  
  438.     {draw one of the "back" bitplanes}
  439.     for i:=1 to NUMBER_FACES do if (NOT face[i].shown) AND (face[i].up) then begin
  440.         with face[i] do begin
  441.             SetBitplanes(1); {Write to bitplane 1 only}
  442.             ClearSlope;
  443.             miny := 200; maxy := 0;
  444.             CalcSlope(l1,l2);
  445.             CalcSlope(l2,l3);
  446.             CalcSlope(l3,l1);
  447.             FillShape(miny, maxy-miny, 1);
  448.             if (miny < scrminy) then scrminy := miny;
  449.             if (maxy > scrmaxy) then scrmaxy := maxy;
  450.         end;
  451.     end;
  452.  
  453.     {draw the other of the "back" bitplanes}
  454.     for i:=1 to NUMBER_FACES do if (NOT face[i].shown) AND (NOT face[i].up) then begin
  455.         with face[i] do begin
  456.             SetBitplanes(2); {write to bitplane 2 only}
  457.             ClearSlope;
  458.             miny := 200; maxy := 0;
  459.             CalcSlope(l1,l2);
  460.             CalcSlope(l2,l3);
  461.             CalcSlope(l3,l1);
  462.             FillShape(miny, maxy-miny, 2);
  463.             if (miny < scrminy) then scrminy := miny;
  464.             if (maxy > scrmaxy) then scrmaxy := maxy;
  465.         end;
  466.     end;
  467.  
  468.     {draw white top faces}
  469.     for i:=1 to NUMBER_FACES do if face[i].shown AND face[i].up then begin
  470.         with face[i] do begin
  471.             SetBitplanes(4); {write to bitplane 3 only}
  472.             ClearSlope;
  473.             miny := 200; maxy := 0;
  474.             CalcSlope(l1,l2);
  475.             CalcSlope(l2,l3);
  476.             CalcSlope(l3,l1);
  477.             FillShape(miny, maxy-miny, 4);
  478.             if (miny < scrminy) then scrminy := miny;
  479.             if (maxy > scrmaxy) then scrmaxy := maxy;
  480.         end;
  481.     end;
  482.  
  483. {$IFDEF DEBUG}
  484.     SetRGB(0,0,0,0);
  485.     while KeyHit[26] do ;
  486. {$ENDIF}
  487. end;
  488.  
  489.  
  490. begin
  491.     SetScreenMode($D);
  492.     InitDemo;
  493.     SetAllInterrupts;
  494.     repeat RunOnce until Key='e';
  495.     RestoreAllInterrupts;
  496.     SetScreenMode(TEXTMODE);
  497. end.
  498.